home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Library / Manuels & Misc / Assembly / AOA.ZIP / CH01 / PACKDATA / PACKEDU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1995-11-05  |  11.0 KB  |  414 lines
  1. (*****************************************************************************)
  2. (*                                                                           *)
  3. (* PackData                                                                  *)
  4. (*                                                                           *)
  5. (* 11/4/95                                                                   *)
  6. (* Randall L. Hyde                                                           *)
  7. (* Copyright 1995, All Rights Reserved Unless Otherwise Noted                *)
  8. (*                                                                           *)
  9. (* This program allows the user to input a month value (1..12), a day         *)
  10. (* value (1..31), and a year value (0..99).  It packs these three values     *)
  11. (* into 16 bits and displays the results.                     *)
  12. (*                                                                           *)
  13. (* Runs under Windows 3.1, Windows 95, and Windows NT.                       *)
  14. (* Source Code: Borland Delphi (object Pascal).                              *)
  15. (*                                                                           *)
  16. (*****************************************************************************)
  17.  
  18. unit Packedu;
  19.  
  20. interface
  21.  
  22. uses
  23.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  24.   Forms, Dialogs, StdCtrls, ExtCtrls,
  25.  
  26.   { Useful conversion routines: bin <-> dec <-> hexadecimal    }
  27.  
  28.   Converts;
  29.  
  30. type
  31.   TPackedData = class(TForm)
  32.     Panel1: TPanel;
  33.     BoundingBox: TGroupBox;
  34.  
  35.     { Button objects }
  36.  
  37.     ExitBtn: TButton;
  38.     AboutBtn: TButton;
  39.  
  40.     { Data Entry Text Boxes }
  41.  
  42.     MonthBin: TEdit;
  43.     DayBin: TEdit;
  44.     YearBin: TEdit;
  45.     MonthDec: TEdit;
  46.     DayDec: TEdit;
  47.     YearDec: TEdit;
  48.  
  49.     { Data output strings }
  50.  
  51.     BinResult: TLabel;
  52.     HexResult: TLabel;
  53.  
  54.     { Labels appearing on the form }
  55.  
  56.     MonthLbl: TLabel;
  57.     DayLbl: TLabel;
  58.     YearLbl: TLabel;
  59.     DataPackLbl: TLabel;
  60.     DecimalLbl: TLabel;
  61.     BinaryLbl: TLabel;
  62.     PackResLbl: TLabel;
  63.  
  64.     { Methods to handle various events }
  65.  
  66.     procedure ExitBtnClick(Sender: TObject);
  67.     procedure AboutBtnClick(Sender: TObject);
  68.     procedure MonthBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  69.     procedure MonthDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  70.     procedure DayDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  71.     procedure DayBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  72.     procedure YearDecKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  73.     procedure YearBinKeyUp(Sender:TObject; var Key:Word; Shift:TShiftState);
  74.     procedure BoundingBoxClick(Sender: TObject);
  75.  
  76.   private
  77.   public
  78.   end;
  79.  
  80. var
  81.   PackedData: TPackedData;
  82.  
  83. implementation
  84.  
  85. {$R *.DFM}
  86.  
  87.  
  88.  
  89. { RangeUnsigned checks the first parameter (a string of decimal digits)    }
  90. { to see if it is a legal unsigned decimal number.  If it is, then it    }
  91. { converts the value to an integer and checks to make sure it is in the    }
  92. { range start..stop.  The function returns true if this is the case,    }
  93. { false otherwise.                            }
  94.  
  95. function RangeUnsigned(const value:string; start, stop:integer):boolean;
  96. var intValue:word;
  97. begin
  98.     result := CheckUnsigned(value);
  99.         if result then begin
  100.  
  101.             intValue := StrToInt(Value);
  102.                 result := (intValue >= Start) and (intValue <= Stop);
  103.  
  104.         end;
  105.  
  106. end;
  107.  
  108.  
  109. { RangeBin is like RangeUnsigned above, except it checks for binary    }
  110. { values rather than decimal values.                    }
  111.  
  112. function RangeBin(const value:string; start, stop:integer):boolean;
  113. var intValue:word;
  114. begin
  115.     result := CheckBin(value);
  116.         if result then begin
  117.  
  118.             intValue := BinToInt(Value);
  119.                 result := (intValue >= Start) and (intValue <= Stop);
  120.  
  121.         end;
  122. end;
  123.  
  124. { The program executes the following procedure when the user hits the    }
  125. { QUIT button.                                }
  126.  
  127. procedure TPackedData.ExitBtnClick(Sender: TObject);
  128. begin
  129.      Halt;
  130. end;
  131.  
  132.  
  133. { The program executes the following procedure when the user hits the    }
  134. { ABOUT button.                                }
  135.  
  136. procedure TPackedData.AboutBtnClick(Sender: TObject);
  137. begin
  138.  
  139.     MessageDlg(
  140.        'Packed Data Demonstration, Copyright 1995 by Randall Hyde',
  141.        mtInformation, [mbOk], 0);
  142.  
  143. end;
  144.  
  145.  
  146.  
  147.  
  148. { MonthDecKeyUp-                            }
  149. { The program calls this procedure whenever the user presses and re-    }
  150. { leases a key in the decimal month data entry text box.  This routine    }
  151. { converts the new string to an integer, verifies that it is in the    }
  152. { range 1..12, packs the new month value into packed data object, and    }
  153. { then displays the new packed data.                    }
  154. { This procedure turns the decimal month background red if there is a    }
  155. { user input error.                            }
  156.  
  157. procedure TPackedData.MonthDecKeyUp(    Sender:TObject;
  158.                     var Key:Word;
  159.                                         Shift:TShiftState
  160.                     );
  161. var
  162.     Year,
  163.         Month,
  164.         Day    :word;
  165. begin
  166.  
  167.      {First, see if this is a legal decimal value in the range 1..12    }
  168.  
  169.      if (RangeUnsigned(MonthDec.Text, 1, 12)) then begin
  170.  
  171.         { Okay, convert the month, day, and year values into integers    }
  172.         { so we can pack them into a 16-bit value.            }
  173.  
  174.         Month := StrToInt(MonthDec.Text);
  175.         Day := StrToInt(DayDec.Text);
  176.         Year := StrToInt(YearDec.Text);
  177.  
  178.         { Since the month has just changed, update the binary represen-    }
  179.         { tation of the month.                        }
  180.  
  181.         MonthBin.Text := IntToBin(Month,4);
  182.  
  183.         { Output the packed data to the appropriate fields on the form.    }
  184.  
  185.         BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
  186.         HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
  187.  
  188.         { Since there was no error, clear any red background that may    }
  189.         { have previously appeared in this field.            }
  190.  
  191.         MonthDec.Color := clWindow;
  192.         MonthBin.Color := clWindow;
  193.  
  194.      end
  195.      else begin
  196.  
  197.            { Come down here if the month just typed is illegal or out of    }
  198.           { range.  Beep the speaker and color the background red.    }
  199.  
  200.           MessageBeep($ffff);
  201.           MonthDec.Color := clRed;
  202.  
  203.      end;
  204.  
  205. end;
  206.  
  207.  
  208. { MonthBinKeyUp-                            }
  209. { Just like the routine above, except this one handles binary input    }
  210. { rather than decimal input.  See the comments above for a running    }
  211. { commentary about this procedure.                    }
  212.  
  213. procedure TPackedData.MonthBinKeyUp(Sender: TObject; var Key: Word;
  214.                                     Shift: TShiftState);
  215. var
  216.     Year,
  217.         Month,
  218.         Day    :word;
  219. begin
  220.  
  221.      if (RangeBin(MonthBin.Text, 1, 12)) then begin
  222.  
  223.         Month := BinToInt(MonthBin.Text);
  224.         Day := BinToInt(DayBin.Text);
  225.         Year := BinToInt(YearBin.Text);
  226.  
  227.         MonthDec.Text := IntToStr(Month);
  228.         BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 6);
  229.         HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
  230.  
  231.         MonthBin.Color := clWindow;
  232.         MonthDec.Color := clWindow;
  233.  
  234.      end
  235.      else begin
  236.  
  237.           MessageBeep($ffff);
  238.           MonthBin.Color := clRed;
  239.  
  240.      end;
  241.  
  242. end;
  243.  
  244.  
  245. { DayDecKeyUp-                                }
  246. { Like the above routines, handles a key up event in the decimal day    }
  247. { text entry box.                            }
  248.  
  249. procedure TPackedData.DayDecKeyUp(    Sender: TObject;
  250.                     var Key: Word;
  251.                                         Shift: TShiftState);
  252. var
  253.     Year,
  254.         Month,
  255.         Day    :word;
  256. begin
  257.  
  258.      if (RangeUnsigned(DayDec.Text, 1, 31)) then begin
  259.  
  260.         Day := StrToInt(DayDec.Text);
  261.         Month := StrToInt(MonthDec.Text);
  262.         Year := StrToInt(YearDec.Text);
  263.  
  264.         DayBin.Text := IntToBin(Day, 5);
  265.         BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
  266.         HexResult.Caption:=IntToHex((Month shl 12) or(Day shl 7) or Year, 4);
  267.  
  268.         DayDec.Color := clWindow;
  269.         DayBin.Color := clWindow;
  270.  
  271.      end
  272.      else begin
  273.  
  274.           MessageBeep($ffff);
  275.           DayDec.Color := clRed;
  276.  
  277.      end;
  278.  
  279. end;
  280.  
  281.  
  282. { Binary data entry version of the routine above.            }
  283.  
  284. procedure TPackedData.DayBinKeyUp(    Sender:TObject;
  285.                     var Key:Word;
  286.                                         Shift:TShiftState
  287.                   );
  288. var
  289.     Year,
  290.         Month,
  291.         Day    :word;
  292. begin
  293.  
  294.      if (RangeBin(DayBin.Text, 1, 31)) then begin
  295.  
  296.         Day := BinToInt(DayBin.Text);
  297.         Month := BinToInt(MonthBin.Text);
  298.         Year := BinToInt(YearBin.Text);
  299.  
  300.         DayDec.Text := IntToStr(Day);
  301.         BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
  302.     HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
  303.  
  304.         DayBin.Color := clWindow;
  305.         DayDec.Color := clWindow;
  306.  
  307.      end
  308.      else begin
  309.  
  310.           MessageBeep($ffff);
  311.           DayBin.Color := clRed;
  312.  
  313.      end;
  314.  
  315. end;
  316.  
  317.  
  318.  
  319.  
  320. { YearDecKeyUp-                                }
  321. { Keystroke event handler for the decimal year data entry text box.    }
  322.  
  323. procedure TPackedData.YearDecKeyUp(    Sender: TObject;
  324.                     var Key: Word;
  325.                                         Shift: TShiftState
  326.                    );
  327. var
  328.     Year,
  329.         Month,
  330.         Day    :word;
  331. begin
  332.  
  333.      if (RangeUnsigned(YearDec.Text, 0, 99)) then begin
  334.  
  335.         Year := StrToInt(YearDec.Text);
  336.         Month := StrToInt(MonthDec.Text);
  337.         Day := StrToInt(DayDec.Text);
  338.  
  339.         YearBin.Text := IntToBin(Year, 7);
  340.         BinResult.Caption:=IntToBin((month shl 12) or (Day shl 7) or Year, 16);
  341.         HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
  342.  
  343.         YearDec.Color := clWindow;
  344.         YearBin.Color := clWindow;
  345.  
  346.      end
  347.      else begin
  348.  
  349.           MessageBeep($ffff);
  350.           YearDec.Color := clRed;
  351.  
  352.      end;
  353.  
  354. end;
  355.  
  356. { Binary version of the above code.                    }
  357.  
  358. procedure TPackedData.YearBinKeyUp(Sender: TObject; var Key: Word;
  359.                                            Shift: TShiftState);
  360. var
  361.     Year,
  362.         Month,
  363.         Day    :word;
  364. begin
  365.  
  366.      if (RangeBin(DayBin.Text, 0, 99)) then begin
  367.  
  368.         Year := BinToInt(YearBin.Text);
  369.         Month:= StrToInt(MonthDec.Text);
  370.         Day:= StrToInt(DayDec.Text);
  371.  
  372.         YearDec.Text := IntToStr(Year);
  373.         BinResult.Caption:=IntToBin((Month shl 12) or (Day shl 7) or Year, 16);
  374.         HexResult.Caption:=IntToHex((Month shl 12) or (Day shl 7) or Year, 4);
  375.  
  376.         YearDec.Color := clWindow;
  377.         YearBin.Color := clWindow;
  378.  
  379.      end
  380.      else begin
  381.  
  382.           MessageBeep($ffff);
  383.           YearDec.Color := clRed;
  384.  
  385.      end;
  386.  
  387. end;
  388.  
  389.  
  390.  
  391.  
  392.  
  393. procedure TPackedData.BoundingBoxClick(Sender: TObject);
  394. var
  395.     Year,
  396.         Month,
  397.         Day    :word;
  398. begin
  399.  
  400.         Year := BinToInt(YearBin.Text);
  401.         Month:= StrToInt(MonthDec.Text);
  402.         Day:= StrToInt(DayDec.Text);
  403.  
  404.         YearDec.Text := IntToStr(Year);
  405.         YearBin.Text := IntToBin(Year,7);
  406.         MonthDec.Text := IntToStr(Month);
  407.         MonthBin.Text := IntToBin(Month,4);
  408.         DayDec.Text := IntToStr(Day);
  409.         DayBin.Text := IntToBin(Day,5);
  410.  
  411. end;
  412.  
  413. end.
  414.